home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / examples / insight / plugins / mylinsys.pro < prev    next >
Encoding:
Text File  |  1997-07-08  |  18.3 KB  |  553 lines
  1. ; $Id: mylinsys.pro,v 1.13 1997/04/22 17:12:33 rob Exp $
  2. ;
  3. ; Copyright (c) 1997, Research Systems, Inc.  All rights reserved.
  4. ;   Unauthorized reproduction prohibited.
  5. ;+
  6. ; FILE:
  7. ;       mylinsys.pro
  8. ;
  9. ; PURPOSE:
  10. ;       This file contains an Analysis PlugIn that computes the
  11. ;       solution of an N-by-N linear system of equations using
  12. ;       one of three methods.
  13. ;
  14. ; CONTENTS:
  15. ;       GENERAL ROUTINES
  16. ;           pro HandleEventsMylinsys    - handle dialog box events
  17. ;
  18. ;       CALLBACK ROUTINES
  19. ;           fun ApplyMyLinSys           - Apply/OK entry point
  20. ;           fun PromptUserMyLinSys      - main entry point (creates dialog)
  21. ;
  22. ;       REGISTRATION FUNCTION
  23. ;           fun MyLinSys                - registers the PlugIn
  24. ;
  25. ;-
  26.  
  27. FORWARD_FUNCTION NORM
  28.  
  29. ; *****************************************************************************
  30. ;       GENERAL ROUTINES
  31. ; *****************************************************************************
  32.  
  33. ; -----------------------------------------------------------------------------
  34. ;
  35. ;   Purpose:  Handle dialog events.
  36. ;
  37. pro HandleEventsMyLinSys, sEvent
  38.  
  39.     ;  Widget state information.
  40.     ;
  41.     common MyLinSysCommon, psState
  42.     wGroup = (*psState).wMainBase
  43.  
  44.     ;  Catch errors.
  45.     ;
  46.     CATCH, error
  47.     if (error ne 0) then begin
  48.         CATCH, /CANCEL
  49.         void = DIALOG_MESSAGE(!ERR_STRING, DIALOG_PARENT=wGroup)
  50.         RETURN
  51.     endif
  52.  
  53.     ; ========================
  54.     ;     PROCESS EVENTS
  55.     ; ========================
  56.  
  57.     case (sEvent.id) of
  58.  
  59.         ; --------------------------------------
  60.         ;     Array Input text
  61.         ; --------------------------------------
  62.         (*psState).wArrayInputText: begin
  63.  
  64.             ; (nothing to do now)
  65.  
  66.         end
  67.  
  68.         ; --------------------------------------
  69.         ;     Vector Input text
  70.         ; --------------------------------------
  71.         (*psState).wVectorInputText: begin
  72.  
  73.             ; (nothing to do now)
  74.  
  75.         end
  76.  
  77.         ; --------------------------------------
  78.         ;     Input browse button for 2D array
  79.         ; --------------------------------------
  80.         (*psState).wArrayInputBrowseButton: begin
  81.  
  82.             ;  Let user browser for an array data name.
  83.             ;
  84.             void = INSGET( $
  85.                 NAME=inputArrayName, $      ; returned name of data selected
  86.                 /EXCLUSIVE, $               ; only one selection
  87.                 TITLE='Select an array.', $ ; title of browser
  88.                 DIMS_LIST=2, $              ; show 2D array data only
  89.                 COUNT=count, $              ; returned count of items selected
  90.                 GROUP=wGroup, $             ; widget group leader
  91.                 _EXTRA=(*psState).extra)    ; extra information
  92.  
  93.             ;  If user selected an item, set data name in text widget.
  94.             ;
  95.             if (count eq 1) then $
  96.                 WIDGET_CONTROL, (*psState).wArrayInputText, $
  97.                     SET_VALUE=inputArrayName
  98.         end
  99.  
  100.         ; --------------------------------------
  101.         ;     Input browse button for 1D vector
  102.         ; --------------------------------------
  103.         (*psState).wVectorInputBrowseButton: begin
  104.  
  105.             ;  Let user browser for a vector data name.
  106.             ;
  107.             void = INSGET( $
  108.                 NAME=inputVectorName, $     ; returned name of data selected
  109.                 /EXCLUSIVE, $               ; only one selection
  110.                 TITLE='Select a vector.', $ ; title of browser
  111.                 DIMS_LIST=1, $              ; show 1D array data only
  112.                 COUNT=count, $              ; returned count of items selected
  113.                 GROUP=wGroup, $             ; widget group leader
  114.                 _EXTRA=(*psState).extra)    ; extra information
  115.  
  116.             ;  If user selected an item, set data name in text widget.
  117.             ;
  118.             if (count eq 1) then $
  119.                 WIDGET_CONTROL, (*psState).wVectorInputText, $
  120.                     SET_VALUE=inputVectorName
  121.         end
  122.         
  123.         ; --------------------------------------
  124.         ;     Method bgroup
  125.         ; --------------------------------------
  126.         (*psState).wLinSysBgroup: begin
  127.  
  128.             WIDGET_CONTROL, (*psState).wLinSysBgroup, GET_VALUE=value 
  129.             (*psState).LinSysMethod = value
  130.         end
  131.  
  132.         ; --------------------------------------
  133.         ;     Double bgroup
  134.         ; --------------------------------------
  135.         (*psState).wDoubleBgroup: begin
  136.  
  137.             WIDGET_CONTROL, (*psState).wDoubleBgroup, GET_VALUE=value
  138.             (*psState).DoubleMethod = value
  139.         end
  140.  
  141.         ; --------------------------------------
  142.         ;     Summary bgroup
  143.         ; --------------------------------------
  144.         (*psState).wSummaryBgroup: begin
  145.  
  146.             WIDGET_CONTROL, (*psState).wSummaryBgroup, GET_VALUE=value
  147.             (*psState).SummaryMethod = value
  148.         end
  149.  
  150.         ; --------------------------------------
  151.         ;     OK/Apply/Cancel buttons
  152.         ; --------------------------------------
  153.         (*psState).wOKApplyCancelButtons: begin
  154.  
  155.             ;  Destroy dialog on successful OK selection, or if user canceled.
  156.             ;
  157.             if ((sEvent.type eq 'OK') or $
  158.                 (sEvent.type eq 'Cancel')) then $
  159.                 WIDGET_CONTROL, (*psState).wMainBase, /DESTROY
  160.         end
  161.  
  162.         ; --------------------------------------
  163.         ;     other events
  164.         ; --------------------------------------
  165.         else:   ; (do nothing)
  166.  
  167.     endcase
  168.  
  169. end             ; HandleEventsMyLinSys
  170.  
  171. ; *****************************************************************************
  172. ;       CALLBACK ROUTINES
  173. ; *****************************************************************************
  174.  
  175. ; -----------------------------------------------------------------------------
  176. ;
  177. ;   Purpose:  Get data and solve linear system.
  178. ;             Fuction returns 1B on success, else 0B.
  179. ;
  180. function ApplyMyLinSys, $
  181.     CIDs=CIDs, $        ; OUT: command ID list from INSPUT/INSVIS calls
  182.     _EXTRA=extra        ; IN: information to pass to commands
  183.  
  184.     ;  Widget state information.
  185.     ;
  186.     common MyLinSysCommon, psState
  187.     wGroup = (*psState).wMainBase
  188.  
  189.     ; ---------------------------------------------------------
  190.     ;  Catch errors.
  191.     ; ---------------------------------------------------------
  192.  
  193.     CATCH, error
  194.     if (error ne 0) then begin
  195.         CATCH, /CANCEL
  196.         void = DIALOG_MESSAGE(!ERR_STRING, DIALOG_PARENT=wGroup)
  197.         RETURN, 0B
  198.     endif
  199.  
  200.     ; ---------------------------------------------------------
  201.     ;  Check inputs.
  202.     ; ---------------------------------------------------------
  203.  
  204.     ;  Get and check array input data name.
  205.     ;
  206.     WIDGET_CONTROL, (*psState).wArrayInputText, GET_VALUE=inputArrayName
  207.     inputArrayName = inputArrayName[0]
  208.     if (inputArrayName eq '') then $
  209.         MESSAGE, 'Must specify Array Input data.', /NONAME
  210.  
  211.     ;  Get array input data.
  212.     ;
  213.     inputArrayData = INSGET( $
  214.         inputArrayName, $           ; name of array data to get
  215.         COUNT=count, $              ; returned number of items found
  216.         DIMS_LIST=2, $              ; data should have this dimensionality
  217.         GROUP=wGroup, $             ; widget group leader
  218.         _EXTRA=extra)               ; extra information
  219.  
  220.     ;  Return if data not found (INSGET displays own error messages).
  221.     ;
  222.     if (count ne 1) then $
  223.         RETURN, 0B
  224.  
  225.     ;  Get and check vector input data name.
  226.     ;
  227.     WIDGET_CONTROL, (*psState).wVectorInputText, GET_VALUE=inputVectorName
  228.     inputVectorName = inputVectorName[0]
  229.     if (inputVectorName eq '') then $
  230.         MESSAGE, 'Must specify Vector Input data.', /NONAME
  231.  
  232.     ;  Get vector input data.
  233.     ;
  234.     inputVectorData = INSGET( $
  235.         inputVectorName, $          ; name of vector data to get
  236.         COUNT=count, $              ; returned number of items found
  237.         DIMS_LIST=1, $              ; data should have this dimensionality
  238.         GROUP=wGroup, $             ; widget group leader
  239.         _EXTRA=extra)               ; extra information
  240.  
  241.     ;  Return if data not found (INSGET displays own error messages).
  242.     ;
  243.     if (count ne 1) then $
  244.         RETURN, 0B
  245.  
  246.     ;  Check input data for correct size.
  247.     ;  The array must be square.
  248.     ;  The array column dimension must match the vector length.
  249.     ;
  250.     aDim = SIZE(inputArrayData)
  251.     vDim = SIZE(inputVectorData)
  252.     if (aDim[1] ne aDim[2]) then $
  253.         MESSAGE, 'Array Input must be square.', /NONAME
  254.     if (aDim[2] ne vDim[vDim[0]+2]) then $
  255.         MESSAGE, 'Array Input and Vector Input are of incompatible size. ' $
  256.             + 'Select a Vector Input with a length of ' $
  257.             + STRCOMPRESS(STRING(aDim[2]), /REMOVE_ALL) + '.', /NONAME
  258.  
  259.     ; ---------------------------------------------------------
  260.     ;  Compute the solution using one of three methods.
  261.     ; ---------------------------------------------------------
  262.  
  263.     ;  Put up wait cursor.
  264.     ;
  265.     WIDGET_CONTROL, (*psState).wMainBase, /HOURGLASS
  266.  
  267.     start = SYSTIME(1)
  268.  
  269.     ;  Use Biconjugate Gradient.
  270.     ;
  271.     if ((*psState).LinSysMethod eq 0) then begin
  272.  
  273.         newData = LINBCG(SPRSIN(inputArrayData, $
  274.             DOUBLE=(*psState).DoubleMethod), inputVectorData, $
  275.             REPLICATE(MEDIAN(inputVectorData, /EVEN), $
  276.             N_ELEMENTS(inputVectorData)), $
  277.             ITOL=1, DOUBLE=(*psState).DoubleMethod)
  278.  
  279.     ;  Use LU decomposition.
  280.     ;
  281.     endif else if ((*psState).LinSysMethod eq 1) then begin
  282.  
  283.         LUDC, inputArrayData, index, DOUBLE=(*psState).DoubleMethod
  284.  
  285.         newData = LUSOL(inputArrayData, index, inputVectorData, $
  286.             DOUBLE=(*psState).DoubleMethod)
  287.  
  288.         ;  Get "fresh" copy of Array Input data.
  289.         ;
  290.         inputArrayData = INSGET( $
  291.             inputArrayName, $
  292.             COUNT=count, $
  293.             DIMS_LIST=2, $
  294.             GROUP=wGroup, $
  295.             _EXTRA=extra)
  296.  
  297.     ;  Use SV decomposition.
  298.     ;
  299.     endif else begin
  300.  
  301.         SVDC, inputArrayData, w, u, v, DOUBLE=(*psState).DoubleMethod
  302.  
  303.         newData = SVSOL(u, w, v, inputVectorData, $
  304.             DOUBLE=(*psState).DoubleMethod)
  305.  
  306.     endelse
  307.  
  308.     stop = SYSTIME(1)
  309.  
  310.     ; ---------------------------------------------------------
  311.     ;  Put the solution into the Insight Data Manager.
  312.     ; ---------------------------------------------------------
  313.  
  314.     description = 'LinSys ' + inputVectorName
  315.  
  316.     outputName = (*psState).outputName
  317.  
  318.     INSPUT, $
  319.         newData, $                      ; the data
  320.         DESCRIPTION=description, $      ; data description
  321.         NAME=outputName, $              ; use this data name
  322.         COUNT=count, $                  ; returned # of items put
  323.         CIDs=CIDs, $                    ; command ID list
  324.         GROUP=wGroup, $                 ; widget group leader
  325.         _EXTRA=extra                    ; extra information
  326.  
  327.     ;  Return if "put" failed.
  328.     ;
  329.     if (count ne 1) then $
  330.         RETURN, 0B
  331.  
  332.     ; ---------------------------------------------------------
  333.     ;  Put the residual into Insight (Data Manager).
  334.     ; ---------------------------------------------------------
  335.     description = 'Residual ' + inputVectorName
  336.  
  337.     resName = 'LinSys Residual'
  338.  
  339.     resData = TRANSPOSE(inputArrayData ## newData - inputVectorData)
  340.  
  341.     INSPUT, $
  342.         resData, $                      ; the data
  343.         DESCRIPTION=description, $      ; data description
  344.         NAME=resName, $                 ; try this data name
  345.         NEW_NAME=resNameUsed, $         ; the data name actually used
  346.         REPLACE=2, $                    ; prompt user if name conflict
  347.         COUNT=count, $                  ; returned # of items put
  348.         CIDs=CIDs, $                    ; command ID list
  349.         GROUP=wGroup, $                 ; widget group leader
  350.         _EXTRA=extra                    ; extra information
  351.  
  352.     ;  Return if "put" failed.
  353.     ;
  354.     if (count ne 1) then $
  355.         RETURN, 0B
  356.  
  357.     ; ---------------------------------------------------------
  358.     ;  Visualize the residual (error plot).
  359.     ; ---------------------------------------------------------
  360.  
  361.     INSVIS, $
  362.         resNameUsed, $      ; name of data item
  363.         TYPE='plot', $      ; visualization type
  364.         MODE='new', $       ; insert | new | overlay
  365.         CIDs=CIDs, $        ; command ID list
  366.         GROUP=wGroup, $     ; widget group leader
  367.         _EXTRA=extra        ; extra information
  368.  
  369.     ; ---------------------------------------------------------
  370.     ;  Create a summary box.
  371.     ; ---------------------------------------------------------
  372.  
  373.     if ((*psState).SummaryMethod eq 1) then begin
  374.  
  375.         msg1 = 'Residual Norm: |Ax - b| =' + $
  376.             STRING(NORM(resData, DOUBLE=(*psState).DoubleMethod))
  377.         msg2 = 'Method Timing:' + STRING(FLOAT(stop-start)) + ' Seconds'
  378.  
  379.         void = DIALOG_MESSAGE([[msg1], [msg2]], /INFORMATION, $
  380.             TITLE='Linear Systems Summary', $
  381.             DIALOG_PARENT=(*psState).wMainBase)
  382.     endif
  383.  
  384.     ; ---------------------------------------------------------
  385.     ;  Successful return.
  386.     ; ---------------------------------------------------------
  387.  
  388.     RETURN, 1B
  389.  
  390. end             ; ApplyMyLinSys
  391.  
  392. ; -----------------------------------------------------------------------------
  393. ;
  394. ;   Purpose:  Main entry point for the PlugIn.
  395. ;
  396. pro PromptUserMyLinSys, $
  397.     GROUP=wGroup, $     ; IN: group leader widget ID
  398.     _EXTRA=extra        ; IN: various information
  399.  
  400.     ;  Widget state information.
  401.     ;
  402.     common MyLinSysCommon, psState
  403.  
  404.     ;  Create modal main base (non-sizable).
  405.     ;
  406.     title = 'Analysis PlugIn - Linear System of Equations'
  407.     wMainBase = WIDGET_BASE(TITLE=title, GROUP_LEADER=wGroup, $
  408.         /COLUMN, /MODAL, /TLB_FRAME_ATTR)
  409.  
  410.     value = [ $
  411.         'Select a 2D array (A) and a 1D vector (b) that define a', $
  412.         'Linear System of Equations,  Ax = b.', $
  413.         'The solution (x) is available through the Data Manager.', $
  414.         'The residual (Ax - b) is displayed as an XY plot.' $
  415.         ]
  416.     for i = 0, N_ELEMENTS(value)-1 do $
  417.         void = WIDGET_LABEL(wMainBase, VALUE=value[i])
  418.  
  419.     ; ------------------------------------------
  420.     ;  Create INPUTS widgets.
  421.     ; ------------------------------------------
  422.  
  423.     wInputsBase = WIDGET_BASE(wMainBase, /COLUMN, /FRAME)
  424.  
  425.     void = WIDGET_LABEL(wInputsBase, VALUE='INPUTS')
  426.  
  427.     ;  Array Input.
  428.     ;
  429.     wInputDataBase = WIDGET_BASE(wInputsBase, /ROW)
  430.     void = WIDGET_LABEL(wInputDataBase, VALUE='Array Input: ')
  431.     wArrayInputText = WIDGET_TEXT(wInputDataBase, VALUE='', /EDITABLE)
  432.     wArrayInputBrowseButton = $
  433.         WIDGET_BUTTON(wInputDataBase, VALUE=' Browse... ')
  434.  
  435.     ;  Vector Input.
  436.     ;
  437.     wInputDataBase = WIDGET_BASE(wInputsBase, /ROW)
  438.     void = WIDGET_LABEL(wInputDataBase, VALUE='Vector Input: ')
  439.     wVectorInputText = WIDGET_TEXT(wInputDataBase, VALUE='', /EDITABLE)
  440.     wVectorInputBrowseButton = $
  441.         WIDGET_BUTTON(wInputDataBase, VALUE=' Browse... ')
  442.  
  443.     wLinSysBase = WIDGET_BASE(wInputsBase, /ROW)
  444.     void = WIDGET_LABEL(wLinSysBase, VALUE='Method: ')
  445.     wLinSysBgroup = CW_BGROUP(wLinSysBase, $
  446.         ['Biconjugate Gradient', 'LU Decomposition', 'SV Decomposition'], $
  447.         /NO_RELEASE, /ROW, /RETURN_NAME, /EXCLUSIVE, SET_VALUE=1)
  448.     LinSysMethod = 1    ; (set default method to LU Decomposition)
  449.  
  450.     wBottomBase = WIDGET_BASE(wMainBase, /ROW)
  451.  
  452.     ; ------------------------------------------
  453.     ;  Create OPTIONS widgets.
  454.     ; ------------------------------------------
  455.  
  456.     wOptionsLabelBase = WIDGET_BASE(wBottomBase, /COLUMN, /FRAME)
  457.     void = WIDGET_LABEL(wOptionsLabelBase, VALUE='OPTIONS')
  458.  
  459.     wOptionsBase = WIDGET_BASE(wOptionsLabelBase, /ROW)
  460.  
  461.     wDoubleBgroup = CW_BGROUP(wOptionsBase, 'Double Precision', $
  462.         /NONEXCLUSIVE, SET_VALUE=0) 
  463.     DoubleMethod = 0
  464.  
  465.     wSummaryBgroup = CW_BGROUP(wOptionsBase, 'Summary', $
  466.         /NONEXCLUSIVE, SET_VALUE=1) 
  467.     SummaryMethod = 1
  468.  
  469.     ; ------------------------------------------
  470.     ;  Create OUTPUTS widgets.
  471.     ; ------------------------------------------
  472.  
  473.     outputName = 'LinSys Solution'
  474.  
  475.     wOutputsLabelBase = WIDGET_BASE(wBottomBase, /COLUMN, /FRAME)
  476.     void = WIDGET_LABEL(wOutputsLabelBase, VALUE='OUTPUTS')
  477.  
  478.     wOutputsBase = WIDGET_BASE(wOutputsLabelBase, /ROW)
  479.  
  480.     void = WIDGET_LABEL(wOutputsBase, $
  481.         VALUE=' Vector Output:  '+outputName)
  482.  
  483.     ; ------------------------------------------
  484.  
  485.     ;  Create OK/Apply/Cancel buttons using special compound widget.
  486.     ;  (Must pass in main modal base, used to set default and cancel buttons.)
  487.     ;
  488.     wOKApplyCancelButtons = CW_INSAPPLY(wMainBase, _EXTRA=extra)
  489.  
  490.     ;  Create dialog state information.
  491.     ;
  492.     sState = { $
  493.         extra: extra, $
  494.         wMainBase: wMainBase, $
  495.         outputName: outputName, $
  496.         wArrayInputText: wArrayInputText, $
  497.         wArrayInputBrowseButton: wArrayInputBrowseButton, $
  498.         wVectorInputText: wVectorInputText, $
  499.         wVectorInputBrowseButton: wVectorInputBrowseButton, $
  500.         wLinSysBgroup: wLinSysBgroup, $
  501.         LinSysMethod: LinSysMethod, $
  502.         wOKApplyCancelButtons: wOKApplyCancelButtons, $
  503.         wDoubleBgroup: wDoubleBgroup, $
  504.         DoubleMethod: DoubleMethod, $
  505.         wSummaryBgroup: wSummaryBgroup, $
  506.         SummaryMethod:SummaryMethod $
  507.         }
  508.  
  509.     ;  Store the state in a heap variable.
  510.     ;
  511.     psState = PTR_NEW(sState, /NO_COPY)
  512.  
  513.     ;  Realize the dialog box.
  514.     ;
  515.     WIDGET_CONTROL, wMainBase, /REALIZE
  516.  
  517.     ;  Start event loop.
  518.     ;
  519.     XMANAGER, 'PromptUserMyLinSys', wMainBase, $
  520.         EVENT_HANDLER='HandleEventsMyLinSys'
  521.  
  522.     ;  Remove widget state info.
  523.     ;
  524.     PTR_FREE, psState
  525.  
  526. end             ; PromptUserMyLinSys
  527.  
  528. ; *****************************************************************************
  529. ;       REGISTRATION FUNCTION
  530. ; *****************************************************************************
  531.  
  532. ; -----------------------------------------------------------------------------
  533. ;
  534. ;   Purpose:  Register the Analysis PlugIn.
  535. ;
  536. function MyLinSys
  537.  
  538.     ;  Return the Analysis PlugIn Registration Structure.
  539.     ;
  540.     RETURN, { $
  541.         type:       'Analysis_PlugIn', $            ; PlugIn type
  542.         title:      'My LinSys...', $               ; PlugIn type
  543.         purpose:    'Solve linear systems.', $      ; PlugIn purpose
  544.         main_proc:  'PromptUserMyLinSys', $         ; main callback
  545.         apply_func: 'ApplyMyLinSys', $              ; apply callback
  546.         version:    '5.0', $                        ; IDL version
  547.         revision:   '1.0' $                         ; PlugIn version
  548.         }
  549.  
  550. end             ; MyLinSys
  551.  
  552. ; -----------------------------------------------------------------------------
  553.